Shareware Grab Bag/Shareware Grab Bag.iso/090/byt86aug.arc/TYPES.DOC

Text File | 1980-01-01 | 11KB | 319 lines

Screen # 1
  0 ( Type definitions
  1
  2 ( Working variables for object compiler)
  3 VARIABLE SIZE        ( Holds storage size of type)
  4 VARIABLE INHERIT     ( Holds address of inherited
                           ops vocab)
  5 VARIABLE OPS         ( Holds address of end of
                           ops vocabulary)
  6 VARIABLE STASH       ( Temporary store for current
                           vocabulary)
  7 VARIABLE PUBLIC      ( Holds link to ordinary
                           dictionary)
  8 VARIABLE LASTLOCAL   ( Holds address of last word
                           in type)
  9 VARIABLE IN.TYPE.DEF?  ( Flag; are we in a type
                             definition?)
 10 VARIABLE VAL         ( Flag; has a VAL index
                           been declared?)
 11
 12 0 CONSTANT FALSE   FALSE NOT   CONSTANT TRUE
    ( For readability)
 13
 14 ( I refuse to use THEN, which is a syntactic
      abomination!!)
 15 : ENDIF  [COMPILE] THEN ;  IMMEDIATE      -->

Screen # 2
  0 ( Type definitions
  1
  2 ( Make a third stack to hold current object's
      address ; its size
  3   determines how deeply type definitions
      may be compounded)
  4  CREATE OSTACK  HERE 16 + ,  16 ALLOT
  5
  6 ( Push parameter stack to object stack)
  7 : OPUSH  OSTACK -2 OVER +!  @ !  ;   ( n ---  )
  8
  9 ( Pop object stack and discard)
 10 : OPOP   2 OSTACK  +!  ;             ( --- )
 11
 12 ( Copy top of object stack and ADD to top
      of parameter stack)
 13 : OCOP+  OSTACK @ @ +  ;      ( n --- n )
 14
 15                                       -->

Screen # 3
  0 ( Type definitions
  1
  2 ( Compile offset into instance variable and
      bump the total)
  3 : OFFSET  SIZE @ 2 + , SIZE +! ;  ( size ---  )
  4
  5 ( Purely for brevity)
  6 : COMPLIT  [COMPILE] LITERAL ;
  7
  8 ( Compile code to add offset into object body)
  9 : COMPILE.ADDOFF   COMPLIT COMPILE OCOP+ ;
 10
 11 ( Create a new instance variable of 'size' bytes)
 12 : VAR   CREATE  OFFSET              ( size ---  )
 13                 IMMEDIATE
 14         DOES>   @ COMPILE.ADDOFF ;
 15                                 -->

Screen # 4
  0 ( Type definitions
  1
  2 ( Open a type declaration)
  3 : TYPE>  LATEST PUBLIC !  ( NFA of last public word)
  4          CREATE           ( Make a header)
  5          HERE LASTLOCAL ! ( Store its PFA)
  6          0 SIZE !         ( Initialisations)
  7          TRUE  IN.TYPE.DEF? !
  8          FALSE INHERIT ! ;
  9
 10 ( Mark boundary which hides the
      instance variables)
 11 : OPS>   HERE            ( Address following
                               last VAR)
 12          0 C,            ( Make dummy name field)
 13          LATEST ,        ( Link field points to
                               last VAR)
 14          DUP CONTEXT @ ! ( Let Forth know about
                               dummy word)
 15          N>LINK OPS ! ;  ( Save its LFA)    -->

Screen # 5
  0 ( Type definitions
  1
  2 ( Save current vocabulary; set operations
      vocabulary)
  3 : UNLOCK  CONTEXT @ DUP  @ STASH !  ! ;
      ( key ---  )
  4
  5 ( Restore current vocabulary)
  6 : LOCK    STASH @ CONTEXT @ ! ;
  7
  8 ( Look up an operation in its type vocabulary)
    ( key --- CFA)
  9 : FINDOP  BL WORD SWAP       ( Get operation name)
 10           UNLOCK FIND LOCK   ( Find it)
 11        0= ABORT" unrecognised operator " ;
            ( Abort if not found)
 12
 13
 14
 15                                             -->

Screen # 6
  0 ( Type definitions
  1
  2 ( Execute an operation immediately, if found)
  3 : DO.OP   SWAP OPUSH FINDOP EXECUTE OPOP ;
     ( addr key --- ?)
  4
  5 ( Compile operation calling sequence)
  6 : COMPILE.CALL  COMPILE OPUSH , COMPILE OPOP ;
     ( CFA ---  )
  7
  8 ( Look-up operation and compile it)
  9 : COMPILE.OP    FINDOP SWAP COMPLIT
      ( addr key ---  )
 10                 COMPILE.CALL ;
 11
 12 ( Fetch size field contents from instance
      variable or type)
 13 : SZ@  2 + @  ;           ( addr --- size)
 14
 15 : SELF ; ( Optional; used for readability only) -->

Screen # 7
  0 ( Type definitions
  1
  2 ( Create an instance variable of a predefined type)
    ( addr --- )
  3 : MAKE.STRUCTVAR  DUP SZ@   ( get size)
  4                 SWAP @    ( Get key)
  5                 CREATE , OFFSET ( Store key and size)
  6                          IMMEDIATE
  7       DOES> DUP @ SWAP SZ@ 2 - ( Get key and offset)
  8             COMPILE.ADDOFF     ( Compile code....  )
  9             FINDOP             ( to treat as..... )
 10             COMPILE.CALL ;     ( an object. )
 11
 12 ( Compile or interpret an operation
      according to state)
 13 : DO.OR.COMP   STATE @ IF   COMPILE.OP
      ( addr key ---  )
 14                        ELSE DO.OP
 15                        ENDIF ;                 -->

Screen # 8
  0 ( Type definitions
  1
  2 ( Allot space initialised to zeroes)
  3 : ALLOTZ   DUP HERE SWAP 0 FILL ALLOT ; ( n ---  )
  4
  5 ( Execute an operation called INIT if
      there is one)
  6 : INITIALIZE SWAP OPUSH
  7        UNLOCK   LIT" INIT"  FIND LOCK
  8        IF EXECUTE ELSE DROP ENDIF  OPOP ;
  9
 10 ( Create a new instance of a type)
    ( addr ---  )
 11 : MAKE.INSTANCE  CREATE HERE SWAP
 12            DUP @ DUP ,      ( Store key into instc)
 13            SWAP SZ@ ALLOTZ  ( Allot its storage)
 14            INITIALIZE               IMMEDIATE
 15            DOES> DUP @ DO.OR.COMP ;             -->

Screen # 9
  0 ( Type definitions
  1
  2 : INCLUDE>  ' >BODY @ INHERIT ! ;
     ( Inherit ops from old type)
  3
  4 ( Juggle dictionary pointers to seal the type body)
  5 : LINKS  HERE BODY> >LINK  PUBLIC @ SWAP !  ( --- )
  6          LASTLOCAL @ BODY> >NAME OPS @ !
  7          INHERIT @ LASTLOCAL @ BODY> >LINK  ! ;
  8
  9 ( Close type declaration)
 10 : ENDTYPE> LATEST CREATE LINKS
     ( Close the body)
 11    , SIZE @ ,        ( Store key and size)
 12      FALSE IN.TYPE.DEF? !
 13      DOES>  IN.TYPE.DEF? @ IF   MAKE.STRUCTVAR
 14                 ELSE MAKE.INSTANCE
 15                 ENDIF ;              -->

Screen # 10
  0 ( Array definitions
  1
  2 ( Calculate address of array element)
  3 : INDEX+  ROT * + ;  ( index PFA width ---  addr)
  4
  5 ( Interpret an array operation)
    ( index PFA key ---  )
  6 : ARRAY.DO.OP  FINDOP
    ( Get operation CFA)
  7                ROT ROT 4 + DUP @
                   ( Get width of element)
  8                INDEX+
                   ( Calculate element address)
  9                OPUSH EXECUTE OPOP ; ( Do it!)
 10
 11 ( Place index on stack at compile time)
 12 : VAL[   TRUE VAL ! [COMPILE] [ ;    IMMEDIATE
 13
 14 ( Reset the VAL flag)
 15 : ~VAL   FALSE VAL ! ;                    -->

Screen # 11
  0 ( Array definitions
  1
  2 ( Compile an array operation)
    ( {index} PFA key ---  )
  3 : ARRAY.COMP.OP  FINDOP >R
        ( Get op CFA and stash it)
  4                  4 + DUP @
                     ( Get width of array)
  5                  VAL @
                     ( Index at compile time?)
  6                  IF   INDEX+ COMPLIT
                     ( Compile el. addr)
  7                  ELSE SWAP COMPLIT COMPLIT
                     ( or code to calc )
  8                  COMPILE INDEX+  ( at runtime)
  9                  ENDIF
 10                  R> COMPILE.CALL  ~VAL ;
                     ( compile op call)
 11
 12 ( Compile or interpret an array op)
    ( index PFA key ---  )
 13 : ARRAY.DO.OR.COMP  STATE @ IF   ARRAY.COMP.OP
 14                             ELSE ARRAY.DO.OP
 15                             ENDIF ;         -->

Screen # 12
  0 ( Array definitions
  1 ( Create a typed array as an instance variable)
    ( count PFA --- )
  2 : ARRAY.VAR  CREATE DUP @ , OVER ,
     ( Store key and count)
  3       SZ@ DUP ,        ( Store width of element)
  4       *                ( Size = count * width)
  5       OFFSET           ( Store offset etc.)
  6       IMMEDIATE
  7       DOES>  DUP @            ( Get key)
  8       FINDOP >R        ( Get op CFA and stash it)
  9       DUP 6 + @                      ( Get offset)
 10       2 - SWAP 4 + @                 ( Get width)
 11 ( Compile el addr)  VAL @ IF   INDEX+ COMPILE.ADDOFF
 12 ( or code to...)          ELSE SWAP COMPLIT COMPLIT
 13 ( calculate it...)             COMPILE INDEX+
 14 ( at runtime)                  COMPILE OCOP+
 15 ENDIF R> COMPILE.CALL ~VAL ;       -->

Screen # 13
  0 ( Array definitions
  1
  2 ( Make a new array instance)    ( count PFA ---  )
  3 : MAKE.ARRAY   CREATE 2DUP @ , ,
                   ( Store key and count)
  4                       SZ@ DUP , SWAP
                          ( Store width)
  5                       *  ALLOTZ
                          ( Allot the space)
  6                       IMMEDIATE
  7                DOES> DUP @ ARRAY.DO.OR.COMP ;
  8
  9 ( Create an array object or variable)
    ( count +++   )
  10 : ARRAY-OF     ' >BODY
  11                IN.TYPE.DEF? @
  12                IF  ARRAY.VAR
  13                ELSE MAKE.ARRAY
  14                ENDIF ;
  15

Screen # 14
  0 (    DATA STRUCTURES EMPLOYED INTERNALLY
  1
  2 OBJECT   <--------------- width ------------------>
  3   +--------+-----+--------------------------------+
  4   | header | key |       storage fields           |
  5   +--------+-----+--------------------------------+
  6
  7 ARRAY-OF OBJECTS
  8   +--------+-----+-------+-------+----------------+
  9   | header | key | count | width |   elements     |
 10   +--------+-----+-------+-------+----------------+
 11
 12 TYPE DEFINING WORD
 13   +--------+-----+------+
 14   | header | key | size |
 15   +--------+-----+------+                         )

Screen # 15
  0 (
  1 VAR NAME
  2   +--------+--------+
  3   | header | offset |
  4   +--------+--------+
  5
  6 STRUCTVAR NAME
  7   +--------+-----+--------+
  8   | header | key | offset |
  9   +--------+-----+--------+
 10
 11 ARRAY.VAR NAME
 12   +--------+-----+-------+-------+--------+
 13   | header | key | count | width | offset |
 14   +--------+-----+-------+-------+--------+
 15                                              )